home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
tphrt3.arc
/
WATCH.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1990-07-23
|
20KB
|
467 lines
program watch;
{----------------------------------------------------------------------------
| Program WATCH.PAS |
| |
| This program creates a stopwatch on the display with "Taylor" split |
| capability. It is meant to show how to use TPHRT with a hardware |
| interrupt in Turbo Pascal. |
| |
| This program uses two timers to keep track of total and lap times. |
| This method can result in a least significant digit "jitter" of .01 sec |
| on the lap timer. A better, but more complex method is to use a single |
| timer to keep track of both. The dual timer method makes for better |
| demo code and was chosen for that reason only. |
| |
| This program uses BIOS interrupt F2h, which is unused in the current |
| interrupt map. If a TSR program is using interrupt F2h, unpredictable |
| results will occur. The original F2h interrupt vector is restored when |
| the program completes. |
| |
| Environment: Turbo Pascal / Stack check OFF |
| |
| (c)1989 Ryle Design, P.O. Box 22, Mt. Pleasant, Michigan 48804 |
| |
| V3.00 Shareware Evaluation Version |
----------------------------------------------------------------------------}
{$S-} { stack check off }
uses
dos, crt, tphrt;
const
TIMEROFF = 0;
TIMERON = 1;
LAPSTOP = 0;
LAPRUN = 1;
F1 = 59;
F2 = 60;
KEYPORT = $60;
OLD09V = $F2;
MSMINS = 60000000;
MSSECS = 1000000;
MSHUNDS = 10000;
var
tstring : string[8];
lstring : string[8];
atom : char;
tstate : integer;
lstate : integer;
laps : integer;
cursor : integer;
ltime : longint;
ttime : longint;
hits : longint;
dtime : array [1..2] of pchrt_type;
old_keybd_int : pointer;
old_f2_int : pointer;
function hide_cursor : integer;
{---------------------------------------------------------------------------
| This function disables the cursor. |
| |
| Globals referenced: none |
| |
| Arguments : void |
| |
| Returns : (integer) cursor shape for later restoration |
---------------------------------------------------------------------------}
var
regs : registers;
begin
regs.ah := 15; { get current video page }
intr($10,regs);
regs.ah := 3; { request cursor shape }
intr($10,regs); { regs.bh has video page from last int86() call }
hide_cursor := regs.cl + ( regs.ch shl 8); { store cursor start & stop rasters }
regs.ah := 1; { set cursor shape }
regs.ch := 32; { set bit 5 - turns cursor off }
intr($10,regs); { and disable cursor }
end; { hide_cursor }
procedure set_cursor(cursortype : integer);
{----------------------------------------------------------------------------
| This procedure sets the cursor to a new shape. |
| |
| Globals referenced: none |
| |
| Arguments : (integer) cursortype - high 8 bits is start raster |
| low 8 bits is stop raster |
| Returns : void |
----------------------------------------------------------------------------}
var
regs : registers;
begin
regs.ah := 1; { set cursor shape }
regs.ch := (cursortype and $FF00) shr 8; { cursor start raster }
regs.cl := (cursortype and $00FF); { cursor stop raster }
intr($10,regs); { call BIOS interupt 10h }
end; { set_cursor }
procedure new_keybd_int; interrupt;
{----------------------------------------------------------------------------
| This procedure is our new interrupt service routine for interrupt 9h. |
| The following occurs: |
| 1. The keyboard hardware port is read to see what key was pressed. |
| 2. If F1 or F2 were pressed, the watch state is checked and |
| appropriate action is taken. |
| 3. The old keyboard interrupt is called. |
| |
| Since this function is invoked by a hardware interrupt, it functions |
| asynchronously to the main program execution and provides extremely |
| high timing accuracy. |
| |
| Globals referenced: tstate |
| lstate |
| ltime |
| ttime |
| laps |
| old_keybd_int |
| |
| Arguments: void |
| |
| Returns : void |
----------------------------------------------------------------------------}
var
scan_code : byte;
regs : registers;
begin
scan_code := port[KEYPORT]; { read keyboard }
if (scan_code = F1) then { check for F1 key }
begin
if (tstate = TIMEROFF) then { if the watch is off ... }
begin
t_entry(1); { start main timer }
t_entry(2); { start lap timer }
tstate := TIMERON; { set state flags }
lstate := LAPRUN;
end
else { the watch was on ... }
begin
t_exit(1); { stop main timer }
t_exit(2); { stop lap timer }
tstate := TIMEROFF; { set flags }
lstate := LAPSTOP;
end;
end
else if (scan_code = F2) then { check for F2 key }
begin
if (tstate = TIMEROFF) then { if watch was off }
begin
t_reset(1); { master reset }
t_reset(2);
ttime := 0;
ltime := 0;
laps := 0;
end
else { if watch was running }
begin
if (lstate = LAPRUN) then { end of lap if lap was running }
begin
t_exit(2);
t_ask_timer(2,hits,ltime);
t_reset(2);
t_entry(2);
lstate := LAPSTOP;
laps := laps + 1;
end
else { current lap continues if lap was off }
begin
lstate := LAPRUN;
end;
end;
end;
intr($F2,regs); { call the old keyboard ISR }
end; { new_keybd_int }
procedure restore_old_keybd_int;
{----------------------------------------------------------------------------
| This procedure restores the original keyboard interrupt and must be |
| called prior to program completion. |
| |
| Globals referenced: old_keybd_int |
| |
| Arguments: void |
| |
| Returns : void |
----------------------------------------------------------------------------}
begin
setintvec(9,old_keybd_int); { restore old ISR vectors }
setintvec($F2,old_f2_int);
end; { restore_old_keybd_int }
procedure install_new_keybd_int;
{----------------------------------------------------------------------------
| This procedure saves the original keyboard interrupt vector and installs|
| the address of our user written interrupt handler in the ISR vector |
| table. |
| |
| Globals referenced: old_keybd_int |
| new_keybd_int |
| |
| Arguments: void |
| |
| Returns : void |
----------------------------------------------------------------------------}
begin
getintvec(9,old_keybd_int); { save old ISR vector }
setintvec(9,addr(new_keybd_int)); { install new ISR vector }
getintvec($F2,old_f2_int); { save old ISR vector }
setintvec($F2,old_keybd_int); { install new ISR vector }
end; { install_new_keybd_int }
procedure make_time_string(tval : longint; var tstring : string);
{----------------------------------------------------------------------------
| This procedure converts a quantity of microseconds into a displayable |
| string in the form MM:SS.HH . |
| |
| Globals referenced: none |
| |
| Arguments: (longint) tval - time in microseconds to convert |
| (string) tstring - string to receive time conversion |
| |
| Returns : void |
----------------------------------------------------------------------------}
var
mins, secs, hunds : integer;
smins,ssecs,shunds : string[2];
begin
mins := tval div MSMINS;
tval := tval - (mins * MSMINS);
secs := tval div MSSECS;
tval := tval - (secs * MSSECS);
hunds := tval div MSHUNDS;
str(mins,smins); { mins to string }
if (length(smins) = 1) then smins := '0' + smins;
str(secs,ssecs); { secs to string }
if (length(ssecs) = 1) then ssecs := '0' + ssecs;
str(hunds,shunds); { hundreds to string }
if (length(shunds) = 1) then shunds := '0' + shunds;
tstring := smins + ':' + ssecs + '.' + shunds; { build final string }
end; { make_time_string }
procedure draw_watch;
{----------------------------------------------------------------------------
| This procedure draws the stopwatch on the display. |
| |
| Globals referenced: none |
| |
| Arguments: void |
| |
| Returns : void |
----------------------------------------------------------------------------}
var
indx : integer;
begin
gotoxy(33,9); write(chr(218)); { draw the corners }
gotoxy(46,9); write(chr(191));
gotoxy(33,15); write(chr(192));
gotoxy(46,15); write(chr(217));
for indx :=34 to 45 do { draw horizontal lines }
begin
gotoxy(indx,9); write(chr(196));
gotoxy(indx,15); write(chr(196));
gotoxy(indx,12); write(chr(196));
end;
for indx :=10 to 14 do { draw vertical lines }
begin
gotoxy(33,indx); write(chr(179));
gotoxy(46,indx); write(chr(179));
end;
gotoxy(33,12); write(chr(195)); { draw vert/horiz intersections }
gotoxy(46,12); write(chr(180));
gotoxy(35,10); write('Total Time');
gotoxy(37,13); write('Lap 00');
end; { draw_watch }
procedure show_total_time(ttime : longint);
{----------------------------------------------------------------------------
| This procedure displays the total time accumulated by the watch in the |
| appropriate area of the watch face. |
| |
| Globals referenced: none |
| |
| Arguments: (longint) ttime - time to display |
| |
| Returns : void |
----------------------------------------------------------------------------}
var
tstring : string;
begin
make_time_string(ttime,tstring); { convert microseconds to MM:SS.HH }
gotoxy(36,11); write(tstring);
end; { show_total_time }
procedure show_lap_time(ltime : longint);
{----------------------------------------------------------------------------
| This procedure displays the current lap time accumulated by the watch in|
| the appropriate area of the watch face. |
| |
| Globals referenced: none |
| |
| Arguments: (longint) ltime - time to display |
| |
| Returns : void |
----------------------------------------------------------------------------}
var
tstring : string;
begin
make_time_string(ltime,tstring); { convert microseconds to MM:SS.HH }
gotoxy(36,14); write(tstring);
end; { show_lap_time }
procedure show_lap(lap : integer);
{----------------------------------------------------------------------------
| This procedure displays the current lap the watch is timing in the |
| appropriate area of the watch face. |
| |
| Globals referenced: none |
| |
| Arguments: (int) lap - lap to display |
| |
| Returns: void |
----------------------------------------------------------------------------}
begin
if (lap = 100) then lap := 0; { roll over after 99 laps }
gotoxy(41,13); write(lap:2);
end; { show_lap }
begin
{ initialize things }
t_start;
ltime := 0;
ttime := 0;
laps := 0;
tstate := TIMEROFF;
lstate := LAPSTOP;
atom := chr(0);
{ set up the display }
clrscr;
cursor := hide_cursor;
gotoxy(26,6); write('TPHRT Demonstration Series');
gotoxy(32,7); write('StopWatch V3.00');
draw_watch;
gotoxy(14,17); write('F1 Starts/Stops Watch F2 Lap Splits/Resets Watch');
gotoxy(35,19); write('<ESC> quits');
show_total_time(ttime);
show_lap_time(ltime);
show_lap(laps);
install_new_keybd_int;
{ watch display update loop }
repeat
if (tstate = TIMEROFF) then
begin
t_ask_timer(1,hits,ttime);
t_ask_timer(2,hits,ltime);
show_total_time(ttime);
show_lap_time(ltime);
show_lap(laps);
end
else
begin
t_get(dtime[1]);
ttime := t_diff(tdata[1]^.tstart,dtime[1]) + tdata[1]^.elapsed;
show_total_time(ttime);
if (lstate = LAPRUN) then
begin
t_get(dtime[2]);
ltime := t_diff(tdata[2]^.tstart,dtime[2]) + tdata[2]^.elapsed;
show_lap_time(ltime);
end
else
begin
show_lap_time(ltime);
show_lap(laps);
end;
end;
if keypressed then atom := readkey;
until (atom = chr(27));
{ if user presses <ESC>, we fall through to here. Clean up and exit }
restore_old_keybd_int;
set_cursor(cursor);
gotoxy(1,23); writeln('StopWatch complete.');
t_stop;
end.
